HPAVC/HPAVC CD-ROM.iso/pc/BOI200P.ZIP/HILO.PAS

Pascal/Delphi Source File | 1992-12-14 | 9.7 KB | 303 lines

{ $D-}
{$V-}

program HiLo;
{ Copyright (C) 1990 Andrew J. Mead                                            }
{ All Rights Reserved.                                                         }
{ Contact POB 1155 Chapel Hill, NC 27514-1155                                  }

{ Version 0.1  beta dated 12/12/90 using BBS Onliner Interface 1.20            }
{ Version 1.00 12/12/90 BOI 1.20 (about 23 minutes later )                     }
{ Vers 2.00 12/12/92 BOI 2.00                                                  }

Uses
  dos,
  crt,
  key,
  boidecl,
  doorlib,
  getcmbbs,
  iolib,
  support;

Const
  bell      = #$07;
  hilo_ins  = 'HILO.INS';
  hilo_max  = 4096;

Var
  hilo_num  : word;    { computer's number        }
  guesses   : array [1..60] of word;
  hilo_won  : boolean; { player success indicator }
  quit      : boolean; { player quit indicator    }
  hilo_char : char;    { standard input variable  }

Procedure GETINSTRUCTIONS;
  begin {* GetInstructions *}
    if Exist(boi_gamedir + hilo_ins) then
        DisplayText(boi_gamedir + hilo_ins) { display online instructions }
    else NotifySysOp(hilo_ins) { tell player to tell SysOp about missing file }
  end;  {* GetInstructions *}

Procedure INITIALIZE;
  begin {* Initialize *}
    hilo_num := Random(hilo_max) + 1; { pick value 1..hilo_max }
    quit := false;
    playerpoints := 0;
    hilo_won := false
  end;  {* Initialize *}

Procedure PLAYGAME;
  var
    moved : boolean;
    linein : string;

  Procedure SHOWGUESS(
      guess : byte;
      hilit : boolean);

    begin {* PlayGame,ShowGuess *}
      PortWindow(1,1,80,boi_pagelength);
      GotoPortXY(((guess - 1) div 15) * 20 + 1,((guess - 1) mod 15) + 3);
      PortColor(cyan,lightgray);
      SendString(IntStr(guess,2) + ')',false);
      if hilit then PortColor(lightcyan,white);
      SendString(IntStr(guesses[guess],5),false);
      if guesses[guess] > hilo_num then
        begin
          if hilit then PortColor(lightgreen,white)
          else PortColor(green,white);
          SendString(' too high',false)
        end
      else if guesses[guess] < hilo_num then
        begin
          if hilit then PortColor(lightred,lightgray)
          else PortColor(red,lightgray);
          SendString(' too low',false)
        end
      else
        begin
          TextPortColor(white);
          SendString(' You Got It',false)
        end
    end;  {* PlayGame,ShowGuess *}

  Procedure SHOWSCREEN;
    var
      sloop : byte;

    begin {* PlayGame,ShowScreen *}
      PortWindow(1,1,80,boi_pagelength);
      ClrPortScr;
      PortColor(lightcyan,white);
      SendString('Hi-Lo Guessing Game',true);
      PortColor(cyan,lightgray);
      SendString(
' # Guess Result      # Guess Result      # Guess Result      # Guess Result',
          false);
      if playerpoints > 0 then
        begin
          for sloop := 1 to playerpoints - 1 do { display each guess }
              ShowGuess(sloop,false);
          ShowGuess(playerpoints,true) { display and highlight last move }
        end;
      GotoPortXY(1,18);
      PortColor(yellow,white);
      SendString('Hi-Lo options: ',false);
      LineWrite('[I]nstructions   ',brown,lightgray,true);
      LineWrite('[T]ime   ',brown,lightgray,boi_usetime);
      LineWrite('[Q]uit',brown,lightgray,true)
    end;  {* PlayGame,ShowScreen *}

  Procedure WRITELINE;
    var
      ltime : word;

    begin {* PlayGame,WriteLine *}
      ClrPortScr;
      TextPortColor(lightgray);
      if boi_usetime then { if timed game, see if time has expired }
        begin
          ltime := LeftTime + 1;
          if boi_timeover then { player has run out of time }
            begin
              SendString(
                  'Your time limit has expired.  Game is being exited.',true);
              boi_timexp := true;
              Exit { no need to continue }
            end
          else if ltime <= boi_warntime then { player is running out of time }
            begin
              boi_statmode := sm_time; { force status line to display time }
              UpdateStatLine;
              if ltime < boi_warntime then { ring bell once per minute }
                begin
                  boi_warntime := ltime;
                  SendString(#$07,false) { ring bell }
                end;
              { tell player how much time they have left }
              SendString('You have less than ' +
                  IntStr(ltime,0) + ' minutes left.',true)
            end
        end;
      { tell player their current score }
      PortColor(yellow,lightgray);
      SendString('You have made ',false);
      PortColor(cyan,white);
      SendString(IntStr(playerpoints,0),false);
      PortColor(cyan,lightgray);
      SendString(' guesses. ',true);
      SendString('Enter your guess: ',false)
    end;  {* PlayGame,WriteLine *}

  Procedure GETINPUT;
    const
      legalmoves = ['1'..'9','Q','I','T'];

    begin {* PlayGame,GetInput *}
      TextPortColor(white);
      repeat
        begin
          if (boi_timer - boi_stime >= 182) and (boi_statmode = sm_time) then
              UpdateStatLine; { update status line every 10 seconds or so }
          hilo_char := ReadPortKey;
          if not (UpCase(hilo_char) in legalmoves) then
              SendString(bell,false)
        end
      until UpCase(hilo_char) in legalmoves;
      TextPortColor(white);
      case UpCase(hilo_char) of
          'Q' :
            begin
              SendString('Quit',true);
              SendString('Do you really want to quit? [Y/N] ',false);
              repeat hilo_char := UpCase(ReadPortKey)
              until hilo_char in ['Y','N'];
              if hilo_char = 'Y' then
                begin
                  quit := true;
                  SendString('Yes',true)
                end
              else SendString('No',false)
            end;
          'I' :
            begin
              GetInstructions;
              ShowScreen;
              PortWindow(1,20,80,boi_pagelength)
            end;
          'T' :
            begin
              PortWindow(1,20,80,boi_pagelength);
              ClrPortScr;
              GotoPortXY(1,1);
              if boi_usetime then SendString('You have less than ' +
                  IntStr(LeftTime,0) + ' minutes remaining.',false)
              else SendString('This function is not operational.',false);
              GotoPortXY(1,2);
              SendString('Press almost any key to continue. ',false);
              ClearBuffers;
              hilo_char := ReadPortKey;
              ClrPortScr
            end;
          else
            begin
              boi_nextchar := hilo_char;
              SetPortXY;
              if playerpoints > 0 then
                  ShowGuess(playerpoints,false);
              PortWindow(1,20,80,boi_pagelength);
              ResetPortXY;
              TextPortColor(white);
              GetString(linein);
              moved := true
            end
        end
    end;  {* PlayGame,GetInput *}

  Procedure PROCESSGUESS;
    var
      guessamount : word;
      dummy       : word;

    begin {* PlayGame,ProcessGuess *}
      Val(linein,guessamount,dummy);
      PortWindow(1,1,80,boi_pagelength);
      if (dummy = 0) and (guessamount > 0) and (guessamount < hilo_max) then
        begin
          Inc(playerpoints);
          guesses[playerpoints] := guessamount;
          ShowGuess(playerpoints,true);
          GotoPortXY(1,19);
          ClrPortEOL;
          if guessamount = hilo_num then
            begin
              PortColor(lightred + blink,white + blink);
              SendString('Congratulations!!!',false);
              PortColor(lightgreen,white);
              SendString('  You''ve Done It!!!',false);
              hilo_won := true
            end
          else
            begin
              TextPortColor(lightgray);
              SendString('Your guess was ',false);
              if guessamount < hilo_num then
                begin
                  PortColor(lightred,lightgray);
                  SendString('Too Low',false)
                end
              else
                begin
                  PortColor(lightgreen,lightgray);
                  SendString('Too High',false)
                end
            end
        end
      else SendString(#7#7#7,false)
    end;  {* PlayGame,ProcessGuess *}

  begin {* PlayGame *}
    ShowScreen;
    repeat
      begin
        PortWindow(1,20,80,boi_pagelength);
        moved := false;
        repeat
          begin
            WriteLine;
            if not boi_timexp then GetInput
          end
        until moved or quit or boi_timexp;
        if not (quit or boi_timexp) then ProcessGuess
      end;
    until quit or hilo_won or boi_timexp;
    PortWindow(1,20,80,boi_pagelength);
    ClrPortScr;
    TextPortColor(lightgray)
  end;  {* PlayGame *}

begin {* pHiLo *}
  If boi_pagelength < 23 then AbortGame(23); { pagelength must be >= 23 lines }
  if boi_allowavt then QueryUser(['1'..'4']) { offer ANSI and AVATAR modes }
  else QueryUser(['1','2']);                 { offer only ANSI modes }
  if WriteCopy(true) then GetInstructions;
  repeat
    begin
      Initialize; { initialize game variables }
      PlayGame;   { play the game }
      EndGame('Guessers',hilo_won,bois_points,bois_lowscore) { Hall of Fame }
    end
  until not boi_replay { player quits, game ends, or no time left }
end.  {* pHiLo *}

Copyright (C) 1990,1992 Andrew J. Mead
All Rights Reserved.

For further information, contact:
Andrew J. Mead
POB 1155
Chapel Hill, NC 27514-1155
1:3641/417 FidoNet    75:7919/417 DoorNet
1@9952 WWIVnet        1@9395 VirtualNet